home *** CD-ROM | disk | FTP | other *** search
/ CD Actual 9 / CDACTUAL9.iso / share / Dos / VARIOS / pascal / DELPHI.SWG / 0005_TPanel component that allows Drag-Drop.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1996-02-21  |  6.8 KB  |  232 lines

  1. unit DropPnl;
  2.  
  3. { (C) 1995, ingenieursbureau Office Automation
  4.   All Rights Reserved
  5.  
  6.   Hereby the right to distribute this work electronically is granted,
  7.   provided such is done for at most a nominal fee. Also the right is
  8.   granted to store this work on a computer system.
  9.   Finally the right is granted to incorporate this work into other
  10.   work provided no fee is asked for this work.
  11.   In all cases of distribution this work must be distributed in full,
  12.   which specifically includes this notice.
  13.   Liability is limited to the amount payed for this work. Legal
  14.   jurisdiction is with the court of Leeuwarden, the Netherlands.
  15.  
  16.   Roelof Osinga, 29 december 1995
  17. }
  18.  
  19. interface
  20.  
  21. uses
  22.   WinTypes, WinProcs, Messages, Classes, Controls, Forms, Graphics,
  23.   StdCtrls, ExtCtrls, Buttons, ShellApi, SysUtils;
  24.  
  25. type
  26.   TDropActions = (daSimple, daRecursive, daEventOnly);
  27.  
  28.   TDropEvent = procedure(Sender : TObject; FileList : TStringList; X, Y: Integer) of object;
  29.  
  30.   TDropPanel = class(TPanel)
  31.   protected
  32.     FDroppedList : TStringList;
  33.     FDroppedPoint : TPoint;
  34.     FDropAction : TDropActions;
  35.     FAtRunTime : boolean;
  36.     FOnDrop : TDropEvent;
  37.     function HandleDroppedGlyphs(aGlyph : TBitmap; const aStr : string) : integer;
  38.     procedure HandleDroppedBitBtnGlyphs(aComp : TBitBtn; const aStr : string);
  39.     procedure HandleDroppedSpeedButtonGlyphs(aComp : TSpeedButton; const aStr : string);
  40.     procedure HandleDroppedFiles;
  41.     function HandleDroppedFilesRec(aComp : TWinControl; dropAt : TPoint) : boolean;
  42.     procedure CreateParams(var Params : TCreateParams); override;
  43.     procedure WMDropFiles(var Message : TMessage); message WM_DROPFILES;
  44.     destructor Destroy; override;
  45.   public
  46.     constructor Create(anOwner : TComponent); override;
  47.   published
  48.     property DropAction : TDropActions read FDropAction write FDropAction default daRecursive;
  49.     property AtRunTime : boolean read FAtRunTime write FAtRunTime default true;
  50.     property OnDrop : TDropEvent read FOnDrop write FOnDrop;
  51.   end;
  52.  
  53. procedure Register;
  54.  
  55. implementation
  56.  
  57. constructor TDropPanel.Create(anOwner : TComponent);
  58. begin
  59.   inherited Create(anOwner);
  60.   FDroppedList := TStringList.Create;
  61.   FDroppedPoint := Point(0,0);
  62.   FDropAction := daRecursive;
  63.   FAtRunTime := true;
  64. end;
  65.  
  66. destructor TDropPanel.Destroy;
  67. begin
  68.   FDroppedList.Free;
  69.   inherited Destroy;
  70. end;
  71.  
  72. procedure TDropPanel.CreateParams(var Params : TCreateParams);
  73. begin
  74.   inherited CreateParams(Params);
  75.   with Params do
  76.   begin
  77.     ExStyle := ExStyle or WS_EX_ACCEPTFILES;
  78.   end;
  79. end;
  80.  
  81. function TDropPanel.HandleDroppedGlyphs(aGlyph : TBitmap; const aStr : string) : integer;
  82. var Glyphs : integer;
  83. begin
  84.   Result := 1;
  85.   try
  86.     aGlyph.LoadFromFile(aStr);
  87.     if (aGlyph.Width mod aGlyph.Height) = 0
  88.     then begin
  89.       Glyphs := aGlyph.Width div aGlyph.Height;
  90.       if Glyphs > 4
  91.       then Glyphs := 1;
  92.       Result := Glyphs;
  93.     end;
  94.   except
  95.     ;
  96.   end;
  97. end;
  98.  
  99. procedure TDropPanel.HandleDroppedBitBtnGlyphs(aComp : TBitBtn; const aStr : string);
  100. begin
  101.   aComp.NumGlyphs := HandleDroppedGlyphs(aComp.Glyph, aStr); {FDroppedList[0]);}
  102. end;
  103.  
  104. procedure TDropPanel.HandleDroppedSpeedButtonGlyphs(aComp : TSpeedButton; const aStr : string);
  105. begin
  106.   aComp.NumGlyphs := HandleDroppedGlyphs(aComp.Glyph, aStr); {FDroppedList[0]);}
  107. end;
  108.  
  109. procedure TDropPanel.HandleDroppedFiles;
  110. var
  111.   i, j, nL, nC : integer;
  112.   comp : TComponent;
  113. begin
  114.   nL := FDroppedList.Count - 1;
  115.   if nL > -1
  116.   then begin
  117.     nC := ControlCount - 1;
  118.     for i := 0 to nC do
  119.     begin
  120.       comp := Controls[i];
  121.       if PtInRect(TControl(comp).BoundsRect, FDroppedPoint)
  122.       then begin
  123.          if comp is TImage
  124.          then (comp as TImage).Picture.LoadFromFile(FDroppedList[0]);
  125.          if comp is TMemo
  126.          then (comp as TMemo).Lines.LoadFromFile(FDroppedList[0]);
  127.          if (comp is TBitBtn)
  128.          then HandleDroppedBitBtnGlyphs(TBitBtn(comp), FDroppedList[0]);
  129.          if (comp is TSpeedButton)
  130.          then HandleDroppedSpeedButtonGlyphs(TSpeedButton(comp), FDroppedList[0]);
  131.        end;
  132.     end;
  133.   end;
  134. end;
  135.  
  136. function TDropPanel.HandleDroppedFilesRec(aComp : TWinControl; dropAt : TPoint) : boolean;
  137. var
  138.   i, nL, nC : integer;
  139.   done : boolean;
  140.   aControl : TComponent;
  141. begin
  142.   done := false;
  143.   nL := FDroppedList.Count - 1;
  144.   if nL > -1
  145.   then begin
  146.     nC := aComp.ControlCount - 1;
  147.     i := -1;
  148.     while not done and (i < nC) do
  149.     begin
  150.       inc(i);
  151.       aControl := aComp.Controls[i];
  152.       if PtInRect(TControl(aControl).BoundsRect, dropAt)
  153.       then begin
  154.          if not done and (aControl is TImage)
  155.          then begin
  156.            try
  157.              (aControl as TImage).Picture.LoadFromFile(FDroppedList[0]);
  158.            except ;
  159.            end;
  160.            done := true;
  161.          end;
  162.          if not done and (aControl is TMemo)
  163.          then begin
  164.            (aControl as TMemo).Lines.LoadFromFile(FDroppedList[0]);
  165.            done := true;
  166.          end;
  167.          if not done and (aControl is TBitBtn)
  168.          then begin
  169.            HandleDroppedBitBtnGlyphs(TBitBtn(aControl), FDroppedList[0]);
  170.            done := true;
  171.          end;
  172.          if not done and (aControl is TSpeedButton)
  173.          then begin
  174.            HandleDroppedSpeedButtonGlyphs(TSpeedButton(aControl), FDroppedList[0]);
  175.            done := true;
  176.          end;
  177.          if not done and (aControl is TWinControl) and
  178.            not ((aControl is TMemo) or (aControl is TBitBtn))
  179.          then begin
  180.            done := HandleDroppedFilesRec(TWinControl(aControl),
  181.                      TWinControl(aControl).ScreenToClient(aComp.ClientToScreen(dropAt)) );
  182.          end;
  183.        end;
  184.     end;
  185.   end;
  186.   if not done and (aComp = Self)
  187.   then MessageBeep(0);
  188.   Result := done;
  189. end;
  190.  
  191. procedure TDropPanel.WMDropFiles(var Message : TMessage);
  192. var
  193.   hDrop : THandle;
  194.   nFiles, i, size : word;
  195.   Pstr : PChar;
  196. begin
  197.   hDrop := Message.WParam;
  198.   Pstr := StrAlloc(256);
  199.   Message.Result := 0; {accept}
  200.   try
  201.     DragQueryPoint(hDrop, FDroppedPoint);
  202.     nFiles := DragQueryFile(hDrop, $FFFF, Pstr, size);
  203.     dec(nFiles);
  204.     FDroppedList.Clear;
  205.     for i := 0 to nFiles do
  206.     begin
  207.       {size := DragQueryFile(hDrop, i, nil, size);}
  208.       size := 255;
  209.       size := DragQueryFile(hDrop, i, Pstr, size+1);
  210.       FDroppedList.Add(StrPas(Pstr));
  211.     end;
  212.   finally
  213.     DragFinish(hDrop);
  214.     StrDispose(Pstr);
  215.   end;
  216.   if Assigned(FOnDrop)
  217.   then FOnDrop(Self, FDroppedList, FDroppedPoint.X, FDroppedPoint.Y);
  218.   if FAtRunTime or (csDesigning in ComponentState)
  219.   then
  220.     case FDropAction of
  221.       daSimple : HandleDroppedFiles;
  222.       daRecursive : HandleDroppedFilesRec(Self, FDroppedPoint);
  223.     end;
  224. end;
  225.  
  226. procedure Register;
  227. begin
  228.   RegisterComponents('IBOA', [TDropPanel]);
  229. end;
  230.  
  231. end.
  232.